home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / ADERJ503 / R54W.MNL < prev    next >
Lisp/Scheme  |  1994-07-04  |  10KB  |  345 lines
  1. ;;;   ACAD.MNL
  2. ;;;   Copyright (C) 1993-1994 by Autodesk, Inc.
  3. ;;;
  4. ;;;   Permission to use, copy, modify, and distribute this software
  5. ;;;   for any purpose and without fee is hereby granted, provided
  6. ;;;   that the above copyright notice appears in all copies and that
  7. ;;;   both that copyright notice and this permission notice appear in
  8. ;;;   all supporting documentation.
  9. ;;;
  10. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
  11. ;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  12. ;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  13. ;;;
  14. ;;;   AutoLISP routines used by the AutoCAD Release 12 Standard Menu.
  15. ;;;
  16. ;;;   This file is loaded automatically following ACAD.MNX.  In turn,
  17. ;;;   it sets up an autoloader and other routines by loading ACADR12.LSP.
  18.  
  19. (princ "\nAutoCAD Versi≤n 12, utilidades de men· ")
  20.  
  21.  
  22. ;;;=== Icon Menu Functions ===
  23.  
  24. ;;;  View -> Layout -> Tiled Viewports...
  25.  
  26. (defun ai_tiledvp_chk ()
  27.   (setq m:err *error* *error* *merrmsg*)
  28.   (if (= (getvar "TILEMODE") 0)
  29.     (progn
  30.       (princ "\n** Orden no permitida a menos que TILEMODE este a (1) (ACT) **")
  31.       (princ)
  32.     )
  33.     (progn
  34.       (menucmd "I=ICON_VPORTI")
  35.       (menucmd "I=*")
  36.     )
  37.   )
  38.   (setq *error* m:err m:err nil)
  39.   (princ)
  40. )
  41.  
  42. (defun ai_tiledvp (num ori / ai_tiles_g ai_tiles_cmde)
  43.   (setq m:err *error* *error* *merrmsg*
  44.         ai_tiles_cmde (getvar "CMDECHO")
  45.         ai_tiles_g (getvar "GRIDMODE")
  46.   )
  47.   (setvar "CMDECHO" 0)
  48.   (setvar "GRIDMODE" 0)
  49.   (cond ((= num 1)
  50.          (command "_.VPORTS" "_SI")
  51.          (setvar "GRIDMODE" ai_tiles_g)
  52.         )
  53.         ((< num 4)
  54.          (command "_.VPORTS" "_SI")
  55.          (command "_.VPORTS" num ori)
  56.          (setvar "GRIDMODE" ai_tiles_g)
  57.         )
  58.         ((= ori nil)
  59.          (command "_.VPORTS" "_SI")
  60.          (command "_.VPORTS" num)
  61.          (setvar "GRIDMODE" ai_tiles_g)
  62.         )
  63.         ((= ori "L")
  64.          (command "_.UNDO" "_M")
  65.          (command "_.VPORTS" "_SI")
  66.          (command "_.VPORTS" "2" "")
  67.          (setvar "CVPORT" (car (cadr (vports))))
  68.          (command "_.VPORTS" "2" "")
  69.          (command "_.VPORTS" "_J" "" (car (cadr (vports))))
  70.          (setvar "CVPORT" (car (cadr (vports))))
  71.          (command "_.VPORTS" "3" "_H")
  72.          (setvar "GRIDMODE" ai_tiles_g)
  73.          (setvar "CVPORT" (car (cadddr (vports))))
  74.          (setvar "GRIDMODE" ai_tiles_g)
  75.          (setvar "CVPORT" (car (cadddr (vports))))
  76.          (setvar "GRIDMODE" ai_tiles_g)
  77.          (setvar "CVPORT" (car (cadddr (vports))))
  78.          (setvar "GRIDMODE" ai_tiles_g)
  79.          (command "_.UNDO" "_E")
  80.         )
  81.         (T
  82.          (command "_.UNDO" "_M")
  83.          (command "_.VPORTS" "_SI")
  84.          (command "_.VPORTS" "2" "")
  85.          (command "_.VPORTS" "2" "")
  86.          (setvar "CVPORT" (car (caddr (vports))))
  87.          (command "_.VPORTS" "_J" "" (car (caddr (vports))))
  88.          (setvar "CVPORT" (car (cadr (vports))))
  89.          (command "_.VPORTS" "3" "_H")
  90.          (setvar "GRIDMODE" ai_tiles_g)
  91.          (setvar "CVPORT" (car (cadddr (vports))))
  92.          (setvar "GRIDMODE" ai_tiles_g)
  93.          (setvar "CVPORT" (car (cadddr (vports))))
  94.          (setvar "GRIDMODE" ai_tiles_g)
  95.          (setvar "CVPORT" (car (cadddr (vports))))
  96.          (setvar "GRIDMODE" ai_tiles_g)
  97.          (command "_.UNDO" "_E")
  98.         )
  99.   )
  100.   (setq *error* m:err m:err nil)
  101.   (setvar "CMDECHO" ai_tiles_cmde)
  102.   (princ)
  103. )
  104.  
  105. ;;;=== Tablet Swap Functions ===
  106.  
  107. (defun ai_tab1 ()
  108.   (if (null T_MENU)
  109.     (setq T_MENU 0)
  110.   )
  111.   (if (= (logand 1 T_MENU) 1)
  112.     (progn (setq T_MENU (- T_MENU 1))
  113.       (if (< (getvar "EXPERT") 4)
  114.         (princ "\nArea alternativa 1 de tableta descargada.")
  115.       )
  116.       (menucmd "T1=TABLET1")
  117.       (if (< (getvar "EXPERT") 1)
  118.         (princ "\nDesignar de men· de tableta de AutoCAD AME y AutoShade.\n")
  119.       )
  120.     )
  121.     (progn 
  122.       (setq T_MENU (+ T_MENU 1))
  123.       (if (< (getvar "EXPERT") 4)
  124.         (princ "\nArea alternativa 1 de tableta cargada.  ")
  125.       )
  126.       (menucmd "T1=TABLET1ALT")
  127.       (if (< (getvar "EXPERT") 1)
  128.         (princ "\nEste area es para sus aplicaciones personales e items de men·.\n")
  129.       )
  130.     )
  131.   )
  132.   (menucmd (strcat "s=HEADER" (itoa T_MENU)))
  133.   (princ)
  134. )
  135.  
  136. (defun ai_tab2 ()
  137.   (if (null T_MENU) (setq T_MENU 0))
  138.   (if (= (logand 2 T_MENU) 2)
  139.     (progn
  140.       (setq T_MENU (- T_MENU 2))
  141.       (if (< (getvar "EXPERT") 4)
  142.         (princ "\nArea alternativa 2 de tableta descargada.  ")
  143.       )
  144.       (menucmd "T2=TABLET2")
  145.       (if old_wv (setvar "WORLDVIEW" old_wv))
  146.       (if (< (getvar "EXPERT") 1)
  147.         (princ "\nLas ordenes PTOVISTA y VISTADIN operan transparentemente en modo Worldview.\n")
  148.       )
  149.     )
  150.     (progn
  151.       (setq T_MENU (+ T_MENU 2))
  152.       (setq old_wv (getvar "WORLDVIEW"))
  153.       (setvar "WORLDVIEW" 0)
  154.       (if (< (getvar "EXPERT") 4)
  155.         (princ "\nArea alternativa 2 de tableta cargada.  ")
  156.       )
  157.       (menucmd "T2=TABLET2ALT")
  158.       (if (< (getvar "EXPERT") 1)
  159.         (princ "\nZoom y otras ordenes necesitan CTRL-C's: PTOVISTA y VISTADIN en modo actual del SCP.\n")
  160.       )
  161.     )
  162.   )
  163.   (menucmd (strcat "s=HEADER" (itoa T_MENU)))
  164.   (princ)
  165. )
  166.  
  167. (defun ai_tab3 ()
  168.   (if (null T_MENU) 
  169.     (setq T_MENU 0)
  170.   )
  171.   (if (= (logand 4 T_MENU) 4)
  172.     (progn
  173.       (setq T_MENU (- T_MENU 4))
  174.       (if (< (getvar "EXPERT") 4)
  175.         (princ "\nArea alternativa 3 de tableta descargada.  ")
  176.       )
  177.       (menucmd "T3=TABLET3")
  178.       (if (< (getvar "EXPERT") 1)
  179.         (princ "\nDesignar unidades MΘtricas del men· NumΘrico.\n")
  180.       )
  181.     )
  182.     (progn
  183.       (setq T_MENU (+ T_MENU 4))
  184.       (if (< (getvar "EXPERT") 4)
  185.         (princ "\nArea alternativa 3 de tableta cargada.  ")
  186.       )
  187.       (menucmd "T3=TABLET3ALT")
  188.       (if (< (getvar "EXPERT") 1)
  189.         (princ "\nDesignar unidades de Pulgadas del men· NumΘrico.\n")
  190.       )
  191.     )
  192.   )
  193.   (menucmd (strcat "s=HEADER" (itoa T_MENU)))
  194.   (princ)
  195. )
  196.  
  197. (defun ai_tab4 ()
  198.   (if (null T_MENU) 
  199.     (setq T_MENU 0)
  200.   )
  201.   (if (= (logand 8 T_MENU) 8)
  202.     (progn
  203.       (setq T_MENU (- T_MENU 8))
  204.       (if (< (getvar "EXPERT") 4)
  205.         (princ "\nArea alternativa 4 de tableta descargada.  ")
  206.       )
  207.       (menucmd "T4=TABLET4")
  208.       (if (< (getvar "EXPERT") 1)
  209.         (princ "\nPredominan los modos Refent de objetos: las ordenes NO se repiten.\n")
  210.       )
  211.     )
  212.     (progn
  213.       (setq T_MENU (+ T_MENU 8))
  214.       (if (< (getvar "EXPERT") 4)
  215.         (princ "\nArea alternativa 4 de tableta cargada.  ")
  216.       )
  217.       (menucmd "T4=TABLET4ALT")
  218.       (if (< (getvar "EXPERT") 1)
  219.         (princ "\nModos Refent requieren ejecutar modos: las ordenes se repiten.\n")
  220.       )
  221.     )
  222.   )
  223.   (menucmd (strcat "s=HEADER" (itoa T_MENU)))
  224.   (princ)
  225. )
  226.  
  227. ;;;=== General Utility Functions ===
  228.  
  229. (defun *merr* (msg)
  230.   (setq *error* m:err m:err nil)
  231.   (princ)
  232. )
  233.  
  234. (defun *merrmsg* (msg)
  235.   (princ msg)
  236.   (setq *error* m:err m:err nil)
  237.   (princ)
  238. )
  239.  
  240. (defun c:rectang ( / cmde pt1 pt2)
  241.   (setq m:err *error* *error* *merr*
  242.         cmde (getvar "CMDECHO")
  243.   )
  244.   (setvar "CMDECHO" 0)
  245.   (setq pt1 (getpoint "\nPrimera esquina: ")
  246.         pt2 (getcorner pt1 "\nOtra esquina: ")
  247.   )
  248.   (command "_.PLINE" pt1 "_non" (list (car pt1) (cadr pt2))
  249.                    pt2 "_non" (list (car pt2) (cadr pt1))
  250.            "_C"
  251.   )
  252.   (setvar "CMDECHO" cmde)
  253.   (setq *error* m:err m:err nil)
  254.   (princ)
  255. )
  256.  
  257. (defun c:ai_peditm (/ m:p0 m:p1)
  258.   (setq m:err *error* *error* *merr*)
  259.   (defun m:p0 (/ m:s1 m:e1 m:e2 m:e3 m:cmde)
  260.     (menucmd"S=X")
  261.     (menucmd"S=PSEL")
  262.     (while (not m:s1)
  263.       (if (setq m:s1 (ssget))
  264.         (progn
  265.           (setq m:e1 (ssname m:s1 0)
  266.                 m:e2 (entget m:e1)
  267.                 m:e3 (cdr (assoc 0 m:e2))
  268.           )
  269.           (if (= m:e3 "POLYLINE")
  270.             (m:p1)
  271.             (if (member m:e3 '("LINE" "ARC"))
  272.               (progn
  273.                 (command "_.PEDIT")
  274.                 (setq m:cmde (getvar "CMDECHO")) ; Enable the "Do you want to
  275.                 (setvar "CMDECHO" 1)             ;   turn it into one?" prompt.
  276.                 (command m:e1)                   ; Supply the Line/Arc entity.
  277.                 (setvar "CMDECHO" m:cmde)        ; Restore CMDECHO setting.
  278.                 (command pause)
  279.                 (menucmd "S=X")
  280.                 (menucmd "S=P0")
  281.               )
  282.               (progn
  283.                 (terpri)
  284.                 (princ "La entidad designada no es una polilφnea.")
  285.                 (terpri)
  286.                 (setq m:s1 nil)
  287.               )
  288.             )
  289.           )
  290.         )
  291.       )
  292.     )
  293.   )
  294.   (defun m:p1 (/ m:a)
  295.     (menucmd"S=X")
  296.     (if (= (setq m:a (cdr (assoc 70 m:e2))) nil)
  297.       (menucmd"S=P0")
  298.       (cond
  299.          ; p0   = Normal 2D polyline menu page
  300.          ; p8   = 3d polyline menu page
  301.          ; p16  = 3d polygon/polyface mesh menu page
  302.          ((not (zerop (logand (+ 16 64) m:a))) ; a polygon or polyface mesh
  303.                (menucmd "s=p16"))
  304.          ((eq 8 (logand 8 m:a))                ; a 3D polyline
  305.                (menucmd "s=p8"))
  306.          (t    (menucmd "s=p0"))               ; Otherwise it's a 2D polyline.
  307.       )
  308.     )
  309.     (command "_.PEDIT" m:e1)
  310.   )
  311.   (m:p0)
  312.   (setq *error* m:err m:err nil)
  313.   (princ)
  314. )
  315.  
  316. ;;;=== Menu Functions ===
  317.  
  318. (defun ai_rootmenus ()
  319.   (setq T_MENU 0)
  320.   (menucmd "S=X")
  321.   (menucmd "S=S")
  322.   (menucmd "T2=TABLET2")
  323.   (menucmd "T3=TABLET3")
  324.   (menucmd "T4=TABLET4")
  325.   (princ)
  326. )
  327.  
  328. (if (not (load "acadr12.lsp" nil))
  329.   (progn
  330.     (princ "Error de carga.")
  331.     (princ "\nacadr12.lsp no encontrado. No se activa el AutoLoader.  ")
  332.     (princ "Otras utilidades ")
  333.   )
  334.   (progn
  335.     (ai_loadaverendr)
  336.     (ai_aloadame)
  337.     (ai_asegrey "~")
  338.   )
  339. )
  340.  
  341. (setvar "MENUCTL" 1)
  342.  
  343. (princ "cargadas.")
  344. (princ)
  345.